home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / browser / browsing.frm (.txt) next >
Encoding:
Visual Basic Form  |  1996-10-29  |  11.4 KB  |  336 lines
  1. VERSION 4.00
  2. Begin VB.Form fCrypt 
  3.    BackColor       =   &H00C0C0C0&
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Crypt"
  6.    ClientHeight    =   4860
  7.    ClientLeft      =   1410
  8.    ClientTop       =   1875
  9.    ClientWidth     =   12570
  10.    ClipControls    =   0   'False
  11.    BeginProperty Font 
  12.       name            =   "MS Sans Serif"
  13.       charset         =   0
  14.       weight          =   700
  15.       size            =   8.25
  16.       underline       =   0   'False
  17.       italic          =   0   'False
  18.       strikethrough   =   0   'False
  19.    EndProperty
  20.    ForeColor       =   &H00000080&
  21.    Height          =   5265
  22.    Left            =   1350
  23.    MaxButton       =   0   'False
  24.    MinButton       =   0   'False
  25.    ScaleHeight     =   4860
  26.    ScaleWidth      =   12570
  27.    Top             =   1530
  28.    Width           =   12690
  29.    Begin VB.PictureBox picShowCont 
  30.       BorderStyle     =   0  'None
  31.       Height          =   495
  32.       Left            =   3480
  33.       ScaleHeight     =   495
  34.       ScaleWidth      =   8655
  35.       TabIndex        =   7
  36.       Top             =   600
  37.       Visible         =   0   'False
  38.       Width           =   8655
  39.       Begin VB.PictureBox picShow 
  40.          BorderStyle     =   0  'None
  41.          Height          =   495
  42.          Left            =   0
  43.          ScaleHeight     =   495
  44.          ScaleWidth      =   495
  45.          TabIndex        =   8
  46.          Top             =   0
  47.          Width           =   495
  48.       End
  49.       Begin VB.Label lblShow 
  50.          BeginProperty Font 
  51.             name            =   "MS Sans Serif"
  52.             charset         =   0
  53.             weight          =   400
  54.             size            =   8.25
  55.             underline       =   0   'False
  56.             italic          =   0   'False
  57.             strikethrough   =   0   'False
  58.          EndProperty
  59.          Height          =   195
  60.          Left            =   600
  61.          TabIndex        =   9
  62.          Top             =   120
  63.          Width           =   7815
  64.          WordWrap        =   -1  'True
  65.       End
  66.    End
  67.    Begin VB.PictureBox picDefault 
  68.       AutoSize        =   -1  'True
  69.       Height          =   540
  70.       Left            =   10200
  71.       Picture         =   "Browsing kinda.frx":0000
  72.       ScaleHeight     =   32
  73.       ScaleMode       =   3  'Pixel
  74.       ScaleWidth      =   32
  75.       TabIndex        =   6
  76.       Top             =   4680
  77.       Visible         =   0   'False
  78.       Width           =   540
  79.    End
  80.    Begin VB.PictureBox picBuff 
  81.       AutoRedraw      =   -1  'True
  82.       Height          =   540
  83.       Left            =   10920
  84.       Picture         =   "Browsing kinda.frx":030A
  85.       ScaleHeight     =   32
  86.       ScaleMode       =   3  'Pixel
  87.       ScaleWidth      =   32
  88.       TabIndex        =   4
  89.       Top             =   4680
  90.       Visible         =   0   'False
  91.       Width           =   540
  92.    End
  93.    Begin VB.PictureBox picSize 
  94.       BorderStyle     =   0  'None
  95.       Height          =   3615
  96.       Left            =   3360
  97.       MouseIcon       =   "Browsing kinda.frx":0614
  98.       MousePointer    =   99  'Custom
  99.       ScaleHeight     =   3615
  100.       ScaleWidth      =   135
  101.       TabIndex        =   3
  102.       Top             =   600
  103.       Width           =   135
  104.    End
  105.    Begin VB.DirListBox dirList 
  106.       Height          =   3180
  107.       Left            =   120
  108.       TabIndex        =   1
  109.       Top             =   1200
  110.       Width           =   3135
  111.    End
  112.    Begin VB.DriveListBox drvList 
  113.       Height          =   315
  114.       Left            =   120
  115.       TabIndex        =   0
  116.       Top             =   600
  117.       Width           =   3135
  118.    End
  119.    Begin VB.FileListBox filList 
  120.       Height          =   255
  121.       Left            =   8160
  122.       TabIndex        =   2
  123.       Top             =   5280
  124.       Visible         =   0   'False
  125.       Width           =   3495
  126.    End
  127.    Begin ComctlLib.StatusBar fStatB 
  128.       Align           =   2  'Align Bottom
  129.       Height          =   330
  130.       Left            =   0
  131.       TabIndex        =   10
  132.       Top             =   4530
  133.       Width           =   12570
  134.       _Version        =   65536
  135.       _ExtentX        =   22172
  136.       _ExtentY        =   582
  137.       _StockProps     =   68
  138.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  139.          name            =   "MS Sans Serif"
  140.          charset         =   0
  141.          weight          =   400
  142.          size            =   8.25
  143.          underline       =   0   'False
  144.          italic          =   0   'False
  145.          strikethrough   =   0   'False
  146.       EndProperty
  147.       AlignSet        =   -1  'True
  148.       Style           =   1
  149.       SimpleText      =   ""
  150.       i1              =   "Browsing kinda.frx":091E
  151.    End
  152.    Begin ComctlLib.ImageList imgFiles 
  153.       Left            =   9600
  154.       Top             =   4680
  155.       _Version        =   65536
  156.       _ExtentX        =   1005
  157.       _ExtentY        =   1005
  158.       _StockProps     =   1
  159.       BackColor       =   -2147483643
  160.       MaskColor       =   12632256
  161.    End
  162.    Begin ComctlLib.ListView lvwFiles 
  163.       Height          =   3255
  164.       Left            =   3480
  165.       TabIndex        =   5
  166.       Top             =   1200
  167.       Width           =   8655
  168.       _Version        =   65536
  169.       _ExtentX        =   15266
  170.       _ExtentY        =   5741
  171.       _StockProps     =   205
  172.       ForeColor       =   -2147483640
  173.       BackColor       =   -2147483643
  174.       Appearance      =   1
  175.       Arrange         =   1
  176.       HideSelection   =   0   'False
  177.       Icons           =   ""
  178.       LabelEdit       =   1
  179.       MultiSelect     =   -1  'True
  180.       SmallIcons      =   ""
  181.       View            =   1
  182.    End
  183. Attribute VB_Name = "fCrypt"
  184. Attribute VB_Creatable = False
  185. Attribute VB_Exposed = False
  186. Option Explicit
  187. Private Declare Function cFileCrypt Lib "t2win-32.dll" (ByVal File1 As String, ByVal File2 As String, ByVal Password As String) As Long
  188. Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
  189. Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long
  190. Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
  191. Private Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
  192. Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Boolean
  193. Private Const fSizeW = 45 'width of sizing picture box
  194. Private fLastX As Single 'used for drawing sizing line
  195. Private icoWidth As Integer
  196. Private fHog As Boolean
  197. Private Function Crypt(FName As String, PW As String) As Boolean
  198.   'encrypts/decrypts file to the same name
  199.   On Error GoTo CErr
  200.   Dim FTemp As String, lRet As Long
  201.   Crypt = False
  202.   FTemp = FName & "tesseract"
  203.   lRet = cFileCrypt(FName, FTemp, PW)
  204.   If lRet < 0 Then Exit Function
  205.   Kill FName
  206.   Name FTemp As FName
  207.   Crypt = True
  208.   Exit Function
  209. CErr:
  210.   Crypt = False
  211.   MsgBox "Error: " & Error(Err), vbCritical, "Error"
  212.   Exit Function
  213. End Function
  214. Private Sub SmartVisible(C As Control, F As Boolean)
  215.   If (C.Visible <> F) Then C.Visible = F
  216. End Sub
  217. Private Sub Talk(Optional Msg)
  218.   If fHog Then Exit Sub
  219.   If IsMissing(Msg) Then
  220.     If fStatB.SimpleText <> "" Then fStatB.SimpleText = ""
  221.   Else
  222.     If fStatB.SimpleText <> Msg Then fStatB.SimpleText = Msg
  223.   End If
  224. End Sub
  225. Private Sub Command2_Click()
  226.   Set Picture1.Picture = imgFiles.ListImages(1).Picture
  227. End Sub
  228. Private Sub Command3_Click()
  229. End Sub
  230. Private Sub Command1_Click()
  231. End Sub
  232. Private Sub TalkHog(Optional Msg)
  233.   If IsMissing(Msg) Then
  234.     fStatB.SimpleText = ""
  235.     fHog = False
  236.   Else
  237.     If fStatB.SimpleText <> Msg Then fStatB.SimpleText = Msg
  238.     fHog = True
  239.   End If
  240. End Sub
  241. Private Sub DirList_Change()
  242.     ' Update the file list box to synchronize with the directory list box.
  243.     filList.Path = dirList.Path
  244. End Sub
  245. Private Sub DirList_LostFocus()
  246.     dirList.Path = dirList.List(dirList.ListIndex)
  247. End Sub
  248. Private Sub dirList_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  249.   Talk "Browse folders"
  250. End Sub
  251. Private Sub DrvList_Change()
  252.     On Error GoTo DriveHandler
  253.     dirList.Path = drvList.Drive
  254.     Exit Sub
  255. DriveHandler:
  256.     drvList.Drive = dirList.Path
  257.     Exit Sub
  258. End Sub
  259. Private Sub filList_PathChange()
  260.   On Error Resume Next
  261.   Dim bRet As Boolean
  262.   DoEvents
  263.   lvwFiles.ListItems.Clear
  264.   SmartVisible picShowCont, False
  265.   Set lvwFiles.Icons = Nothing
  266.   Set lvwFiles.SmallIcons = Nothing
  267.   imgFiles.ListImages.Clear
  268.   MousePointer = vbHourglass
  269.   TalkHog "Retrieving files in folder..."
  270.   Dim sPath As String, W As Long
  271.   sPath = IIf(Right(filList.Path, 1) = "\", filList.Path, filList.Path & "\")
  272.   Dim imgT As ListImage, i As Integer, hIcon
  273.   For i = 0 To filList.ListCount - 1
  274.     W = 1
  275.     hIcon = ExtractAssociatedIcon(0, sPath & filList.List(i), W)
  276.     If IsNull(hIcon) Then 'function failed
  277.       picBuff.Picture = picDefault.Picture
  278.     Else
  279.       Set picBuff.Picture = Nothing
  280.       DoEvents
  281.       DrawIcon picBuff.hdc, 0, 0, hIcon
  282.       DoEvents
  283.       picBuff.Picture = picBuff.Image
  284.       DoEvents
  285.     End If
  286.     Set imgT = imgFiles.ListImages.Add(, , picBuff.Picture)
  287.   Next
  288.   lvwFiles.Icons = imgFiles
  289.   lvwFiles.SmallIcons = imgFiles
  290.   For i = 0 To filList.ListCount - 1
  291.     lvwFiles.ListItems.Add , , filList.List(i), i + 1, i + 1
  292.   Next
  293.   TalkHog
  294.   MousePointer = vbDefault
  295. End Sub
  296. Private Sub Form_Load()
  297.   fLastX = -100
  298.   icoWidth = 32
  299.   Call filList_PathChange
  300. End Sub
  301. Private Sub Form_Unload(Cancel As Integer)
  302.     End
  303. End Sub
  304. Private Sub lvwFiles_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  305.   Dim L As ListItem
  306.   Set L = lvwFiles.HitTest(X, Y)
  307.   If L Is Nothing Then Exit Sub
  308.   'L is an item, so carry on
  309.   SmartVisible picShowCont, True
  310.   picShow.Picture = imgFiles.ListImages(L.Index).Picture
  311.   lblShow.Caption = L.Text
  312.   Talk "Select a file/group of files to do whatever to..."
  313. End Sub
  314. Private Sub picSize_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  315.   DrawMode = vbXorPen
  316.   DrawWidth = 3
  317.   Line (picSize.Left + X, picSize.Top)-(picSize.Left + X, picSize.Top + picSize.Height), vbWhite
  318.   fLastX = picSize.Left + X
  319. End Sub
  320. Private Sub picSize_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  321.   If fLastX >= 0 Then
  322.     Line (fLastX, picSize.Top)-(fLastX, picSize.Top + picSize.Height), vbWhite
  323.   Else
  324.     Exit Sub 'do not draw just for no reason
  325.   End If
  326.   Line (picSize.Left + X, picSize.Top)-(picSize.Left + X, picSize.Top + picSize.Height), vbWhite
  327.   fLastX = picSize.Left + X
  328. End Sub
  329. Private Sub picSize_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  330.   If fLastX >= 0 Then
  331.     Line (fLastX, picSize.Top)-(fLastX, picSize.Top + picSize.Height), vbWhite
  332.   End If
  333.   fLastX = -100
  334.   'do resizing here
  335. End Sub
  336.